home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / tcltk / tk8.4 / panedwindow.tcl < prev    next >
Text File  |  2009-04-29  |  5KB  |  189 lines
  1. # panedwindow.tcl --
  2. #
  3. # This file defines the default bindings for Tk panedwindow widgets and
  4. # provides procedures that help in implementing those bindings.
  5. #
  6. # RCS: @(#) $Id: panedwindow.tcl,v 1.6.2.4 2006/01/25 18:21:41 dgp Exp $
  7. #
  8.  
  9. bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  10. bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  11.  
  12. bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
  13. bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
  14.  
  15. bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
  16. bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
  17.  
  18. bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
  19.  
  20. bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
  21.  
  22. # Initialize namespace
  23. namespace eval ::tk::panedwindow {}
  24.  
  25. # ::tk::panedwindow::MarkSash --
  26. #
  27. #   Handle marking the correct sash for possible dragging
  28. #
  29. # Arguments:
  30. #   w        the widget
  31. #   x        widget local x coord
  32. #   y        widget local y coord
  33. #   proxy    whether this should be a proxy sash
  34. # Results:
  35. #   None
  36. #
  37. proc ::tk::panedwindow::MarkSash {w x y proxy} {
  38.     if {[$w cget -opaqueresize]} { set proxy 0 }
  39.     set what [$w identify $x $y]
  40.     if { [llength $what] == 2 } {
  41.     foreach {index which} $what break
  42.     if { !$::tk_strictMotif || $which eq "handle" } {
  43.         if {!$proxy} { $w sash mark $index $x $y }
  44.         set ::tk::Priv(sash) $index
  45.         foreach {sx sy} [$w sash coord $index] break
  46.         set ::tk::Priv(dx) [expr {$sx-$x}]
  47.         set ::tk::Priv(dy) [expr {$sy-$y}]
  48.         # Do this to init the proxy location
  49.         DragSash $w $x $y $proxy
  50.     }
  51.     }
  52. }
  53.  
  54. # ::tk::panedwindow::DragSash --
  55. #
  56. #   Handle dragging of the correct sash
  57. #
  58. # Arguments:
  59. #   w        the widget
  60. #   x        widget local x coord
  61. #   y        widget local y coord
  62. #   proxy    whether this should be a proxy sash
  63. # Results:
  64. #   Moves sash
  65. #
  66. proc ::tk::panedwindow::DragSash {w x y proxy} {
  67.     if {[$w cget -opaqueresize]} { set proxy 0 }
  68.     if { [info exists ::tk::Priv(sash)] } {
  69.     if {$proxy} {
  70.         $w proxy place \
  71.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  72.     } else {
  73.         $w sash place $::tk::Priv(sash) \
  74.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  75.     }
  76.     }
  77. }
  78.  
  79. # ::tk::panedwindow::ReleaseSash --
  80. #
  81. #   Handle releasing of the sash
  82. #
  83. # Arguments:
  84. #   w        the widget
  85. #   proxy    whether this should be a proxy sash
  86. # Results:
  87. #   Returns ...
  88. #
  89. proc ::tk::panedwindow::ReleaseSash {w proxy} {
  90.     if {[$w cget -opaqueresize]} { set proxy 0 }
  91.     if { [info exists ::tk::Priv(sash)] } {
  92.     if {$proxy} {
  93.         foreach {x y} [$w proxy coord] break
  94.         $w sash place $::tk::Priv(sash) $x $y
  95.         $w proxy forget
  96.     }
  97.     unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)
  98.     }
  99. }
  100.  
  101. # ::tk::panedwindow::Motion --
  102. #
  103. #   Handle motion on the widget.  This is used to change the cursor
  104. #   when the user moves over the sash area.
  105. #
  106. # Arguments:
  107. #   w        the widget
  108. #   x        widget local x coord
  109. #   y        widget local y coord
  110. # Results:
  111. #   May change the cursor.  Sets up a timer to verify that we are still
  112. #   over the widget.
  113. #
  114. proc ::tk::panedwindow::Motion {w x y} {
  115.     variable ::tk::Priv
  116.     set id [$w identify $x $y]
  117.     if {([llength $id] == 2) && \
  118.         (!$::tk_strictMotif || [lindex $id 1] eq "handle")} {
  119.     if { ![info exists Priv($w,panecursor)] } {
  120.         set Priv($w,panecursor) [$w cget -cursor]
  121.         if { [$w cget -sashcursor] eq "" } {
  122.         if { [$w cget -orient] eq "horizontal" } {
  123.             $w configure -cursor sb_h_double_arrow
  124.         } else {
  125.             $w configure -cursor sb_v_double_arrow
  126.         }
  127.         } else {
  128.         $w configure -cursor [$w cget -sashcursor]
  129.         }
  130.         if {[info exists Priv($w,pwAfterId)]} {
  131.         after cancel $Priv($w,pwAfterId)
  132.         }
  133.         set Priv($w,pwAfterId) [after 150 \
  134.             [list ::tk::panedwindow::Cursor $w]]
  135.     }
  136.     return
  137.     }
  138.     if { [info exists Priv($w,panecursor)] } {
  139.     $w configure -cursor $Priv($w,panecursor)
  140.     unset Priv($w,panecursor)
  141.     }
  142. }
  143.  
  144. # ::tk::panedwindow::Cursor --
  145. #
  146. #   Handles returning the normal cursor when we are no longer over the
  147. #   sash area.  This needs to be done this way, because the panedwindow
  148. #   won't see Leave events when the mouse moves from the sash to a
  149. #   paned child, although the child does receive an Enter event.
  150. #
  151. # Arguments:
  152. #   w        the widget
  153. # Results:
  154. #   May restore the default cursor, or schedule a timer to do it.
  155. #
  156. proc ::tk::panedwindow::Cursor {w} {
  157.     variable ::tk::Priv
  158.     # Make sure to check window existence in case it is destroyed.
  159.     if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
  160.     if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
  161.         set Priv($w,pwAfterId) [after 150 \
  162.             [list ::tk::panedwindow::Cursor $w]]
  163.     } else {
  164.         $w configure -cursor $Priv($w,panecursor)
  165.         unset Priv($w,panecursor)
  166.         if {[info exists Priv($w,pwAfterId)]} {
  167.         after cancel $Priv($w,pwAfterId)
  168.         unset Priv($w,pwAfterId)
  169.         }
  170.     }
  171.     }
  172. }
  173.  
  174. # ::tk::panedwindow::Leave --
  175. #
  176. #   Return to default cursor when leaving the pw widget.
  177. #
  178. # Arguments:
  179. #   w        the widget
  180. # Results:
  181. #   Restores the default cursor
  182. #
  183. proc ::tk::panedwindow::Leave {w} {
  184.     if {[info exists ::tk::Priv($w,panecursor)]} {
  185.         $w configure -cursor $::tk::Priv($w,panecursor)
  186.         unset ::tk::Priv($w,panecursor)
  187.     }
  188. }
  189.